home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
os2
/
adaptor.zip
/
ADAPT.ZIP
/
adaptor
/
src
/
adaptsca.c
< prev
next >
Wrap
Text File
|
1994-01-03
|
10KB
|
401 lines
# include "Scalar.h"
# include "yyAScala.w"
# include <stdio.h>
# if defined __STDC__ | defined __cplusplus
# include <stdlib.h>
# else
extern void exit ();
# endif
# include "Tree.h"
# include "Definiti.h"
# ifndef NULL
# define NULL 0L
# endif
# ifndef false
# define false 0
# endif
# ifndef true
# define true 1
# endif
# ifdef yyInline
# define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
free += nodesize [kind]; \
ptr->yyHead.yyMark = 0; \
ptr->Kind = kind;
# else
# define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
# endif
# define yyWrite(s) (void) fputs (s, yyf)
# define yyWriteNl (void) fputc ('\n', yyf)
# line 8 "AdaptScalar.puma"
# include <stdio.h>
# include "Idents.h"
# include "StringMe.h"
# include "protocol.h"
# include "Types.h" /* LastIndex */
# include "Transfor.h" /* ExpToVarParam */
# include "Dalib.h" /* IsHost, ... */
# include "Movement.h" /* AdaptNNCopy */
# include "Reductio.h"
# include "Local.h" /* LocalArrayAssignment */
# include "Broadcas.h" /* MakeBroadcast */
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module AdaptScalar, routine %s failed\n", yyFunction);
exit (1);
}
tTree AdaptScalarAssign ARGS((tTree assign, int vardistribution, int expdistribution));
static tTree AdaptScalarReduction ARGS((tTree assign, tTree var, tTree exp));
static tTree GenReductionStmt ARGS((tTree var, tTree funccall));
tTree AdaptScalarAssign
# if defined __STDC__ | defined __cplusplus
(register tTree assign, register int vardistribution, register int expdistribution)
# else
(assign, vardistribution, expdistribution)
register tTree assign;
register int vardistribution;
register int expdistribution;
# endif
{
# line 34 "AdaptScalar.puma"
tTree mask, t;
char string[200];
if (assign->Kind == kACF_BASIC) {
if (assign->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
if (equalint (vardistribution, 0)) {
if (equalint (expdistribution, 0)) {
# line 45 "AdaptScalar.puma"
return assign;
}
}
if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kVAR_EXP) {
if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V->Kind == kINDEXED_VAR) {
{
tTree new;
if (equalint (vardistribution, 0)) {
if (equalint (expdistribution, - 1)) {
# line 58 "AdaptScalar.puma"
{
# line 61 "AdaptScalar.puma"
# line 63 "AdaptScalar.puma"
if (IsHost)
{ new = MakeBroadcast (CopyTree (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR));
new = mACF_LIST (assign, mACF_LIST (new, NoTree));
}
else
new = MakeBroadcast (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
}
{
return new;
}
}
}
}
{
tTree params;
tTree new;
if (equalint (vardistribution, 0)) {
if (equalint (expdistribution, 1)) {
# line 82 "AdaptScalar.puma"
{
# line 89 "AdaptScalar.puma"
# line 90 "AdaptScalar.puma"
# line 92 "AdaptScalar.puma"
params = DalibLastActualParam (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, mBTP_EMPTY());
params = DalibLastFormalParam (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, params);
params = DalibTreeSizeParam (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, params);
if (IsHost)
params = mBTP_LIST (mVAR_PARAM (CopyTree(assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR)), params);
else
params = mBTP_LIST (mVAR_PARAM (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V), params);
params = mBTP_LIST (mVAR_PARAM (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR), params);
new = mCALL_STMT (mPROC_OBJ (MakeDalibId ("node_get")), params);
new = mACF_BASIC (new);
}
{
return new;
}
}
}
}
}
}
if (equalint (vardistribution, 0)) {
# line 115 "AdaptScalar.puma"
{
# line 116 "AdaptScalar.puma"
if (! ((IsReduction (assign) == true))) goto yyL4;
{
# line 117 "AdaptScalar.puma"
t = AdaptScalarReduction (assign, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP);
if (t == NoTree)
error_protocol ("adaption of reduction fails\n");
}
}
return t;
yyL4:;
}
if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR->Kind == kINDEXED_VAR) {
if (equalint (vardistribution, 1)) {
if (equalint (expdistribution, 0)) {
# line 130 "AdaptScalar.puma"
{
# line 134 "AdaptScalar.puma"
if (IsHost)
t = NoTree;
else
t = LocalArrayAssignment (assign);
}
return t;
}
}
if (equalint (vardistribution, 1)) {
if (equalint (expdistribution, 1)) {
# line 149 "AdaptScalar.puma"
{
# line 150 "AdaptScalar.puma"
if (!IsHost)
{ if (CountMovements (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP) == 0)
{
t = LocalArrayAssignment (assign);
}
else if (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind != kVAR_EXP)
{ error_protocol ("Scalar Node-Copy failed");
t = NoTree;
}
else
{
stmt_protocol ("Scalar Node<->Node Transfer");
t = AdaptNNCopy (assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, assign->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V);
if (t == NoTree)
error_protocol ("fails");
else
tree_protocol ("becomes : ", t);
}
}
else t = NoTree;
}
return t;
}
}
if (equalint (vardistribution, - 1)) {
if (equalint (expdistribution, 0)) {
# line 179 "AdaptScalar.puma"
{
# line 183 "AdaptScalar.puma"
if (IsHost)
mask = assign;
else
mask = NoTree;
}
return mask;
}
}
if (equalint (vardistribution, - 1)) {
if (equalint (expdistribution, - 1)) {
# line 191 "AdaptScalar.puma"
{
# line 195 "AdaptScalar.puma"
if (IsHost)
mask = assign;
else
mask = NoTree;
}
return mask;
}
}
}
}
}
if (equalint (vardistribution, - 1)) {
# line 203 "AdaptScalar.puma"
{
# line 204 "AdaptScalar.puma"
error_protocol ("Update of a host var with distributed var");
}
return assign;
}
# line 208 "AdaptScalar.puma"
{
# line 209 "AdaptScalar.puma"
sprintf (string, "AdaptScalarAssign failed, vardist= %d, expdist= %d\n", vardistribution, expdistribution);
# line 211 "AdaptScalar.puma"
error_protocol (string);
}
return assign;
}
static tTree AdaptScalarReduction
# if defined __STDC__ | defined __cplusplus
(register tTree assign, register tTree var, register tTree exp)
# else
(assign, var, exp)
register tTree assign;
register tTree var;
register tTree exp;
# endif
{
# line 224 "AdaptScalar.puma"
tTree mask, t, last;
if (exp->Kind == kFUNC_CALL_EXP) {
if (exp->FUNC_CALL_EXP.FUNC_PARAMS->Kind == kBTP_LIST) {
if (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
if (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->Kind == kUSED_VAR) {
# line 228 "AdaptScalar.puma"
{
# line 230 "AdaptScalar.puma"
t = GenReductionStmt (var, exp);
if (t == NoTree)
{ error_protocol ("generate reduction fails");
t = assign;
}
else
{ stmt_protocol ("Global reduction: ");
if (!IsHost)
t = mACF_LIST (assign, mACF_LIST (t, NoTree));
}
}
return t;
}
if (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->Kind == kINDEXED_VAR) {
# line 245 "AdaptScalar.puma"
{
# line 247 "AdaptScalar.puma"
t = GenReductionStmt (var, exp);
if (!IsHost)
{
t = mACF_LIST (assign, mACF_LIST (t, NoTree));
last = LastIndex (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_EXPS);
if (last->Kind == kSLICE_EXP)
{
mask = MakeRangeStmt (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR, last);
if (mask != NoTree)
t = mACF_LIST (mask, t);
}
else
{
mask = MakeRangeStmt (exp->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR, last);
if (mask != NoTree)
t = mACF_LIST (mask, t);
}
}
}
return t;
}
}
}
}
# line 272 "AdaptScalar.puma"
return NoTree;
}
static tTree GenReductionStmt
# if defined __STDC__ | defined __cplusplus
(register tTree var, register tTree funccall)
# else
(var, funccall)
register tTree var;
register tTree funccall;
# endif
{
# line 279 "AdaptScalar.puma"
tTree t;
if (funccall->Kind == kFUNC_CALL_EXP) {
if (funccall->FUNC_CALL_EXP.FUNC_PARAMS->Kind == kBTP_LIST) {
if (funccall->FUNC_CALL_EXP.FUNC_PARAMS->BTP_LIST.Next->Kind == kBTP_EMPTY) {
# line 281 "AdaptScalar.puma"
{
# line 282 "AdaptScalar.puma"
t = GlobalReductionStmt (var, TreeType (var), funccall->FUNC_CALL_EXP.FUNC_ID);
}
return t;
}
}
# line 287 "AdaptScalar.puma"
{
# line 288 "AdaptScalar.puma"
printf ("Generate Reduction Statement failed (too many params)\n");
# line 289 "AdaptScalar.puma"
printf ("var = ");
# line 289 "AdaptScalar.puma"
FileUnparse (stdout, var);
# line 289 "AdaptScalar.puma"
printf ("\n");
# line 290 "AdaptScalar.puma"
printf ("call = ");
# line 290 "AdaptScalar.puma"
FileUnparse (stdout, funccall);
# line 290 "AdaptScalar.puma"
printf ("\n");
}
return NoTree;
}
yyAbort ("GenReductionStmt");
}
void BeginAdaptScalar ()
{
}
void CloseAdaptScalar ()
{
}